Libris Britannia 4/science library(b).zip/science library(b)/TECHNICA/AUTOCAD/H107.ZIP/APR91.ZIP/PDIM.LSP

Text File | 1991-05-13 | 7KB | 293 lines

; PDIM.LSP   [Article Figure 1]   (c)1991, Phil Kreiker

;--------------------------------------------------------------
; PDim.LSP -- COPYRIGHT 1990 BY LOOKING GLASS MICROPRODUCTS
;--------------------------------------------------------------
(Setq
   vplayer  "VPORTS"
   dimlayer "DIMS"
   ucs      1
)
;--------------------------------------------------------------
; Load-time chewing gum
(Princ "\n")
(Setq bcount 0)
(Defun bump ()
   (Setq bcount (1+ bcount))
   (Princ
      (Strcat
         "\rLoading PDim.Lsp v 1.0 ["
         (Nth
            (Rem bcount 4)
            '("/" "-" "\\" "|")
         )
         "] Copyright 1990 by Looking Glass Microproducts"
      )
   )
)
;-----------------------------------------------------
; Item from association list
(bump)
(Defun item (n e)
   (CDR (Assoc n e))
)
;-----------------------------------------------------
; Error Handler
(bump)
(Defun PDim-error (s)
   (If (/= S "Function cancelled")
      (Princ s)
   )
   (Command)
   (Command)
   (Command ".UNDO" "e")
   (If undoit
      (Progn (Command ".U"))
   )
   (moder)
)
;-----------------------------------------------------
; System variable save
(bump)
(Defun modes (a)
   (Setq MLST Nil)
   (Repeat
      (Length a)
      (Setq
         MLST (Append
                 MLST
                 (List
                    (List
                       (CAR a)
                       (GetVar (CAR a))
                    )
                 )
              )
      )
      (Setq a (CDR a))
   )
)
;-----------------------------------------------------
; System variable restore
(bump)
(Defun moder ()
   (Repeat
      (Length MLST)
      (Setvar
         (CAAR MLST) (CADAR MLST)
      )
      (Setq MLST (CDR MLST))
   )
   (Setq *Error* olderror)
   (Princ)
)
;-----------------------------------------------------
; Get a Viewport
(bump)
(Defun getvport (/ again ename ent esel)
   (Setq again T)
   (While again
      (If (Setq
             ename (CAR
                      (Setq
                         esel (EntSel "\nSelect viewport: ")
                      )
                   )
          )
         (Progn
            (Setq ent (EntGet ename))
            (If (= (item 0 ent) "VIEWPORT")
               (Progn (Setq again Nil) esel)
               (Princ "\nNot a viewport.")
            )
         )
      )
   )
)
;-----------------------------------------------------
; Highlight Viewport Entity
(Defun highlight (vpent color hlite / vpcen half-height half-width
                  p1 p2 p3 p4)
   (Setq
      vpcen       (item 10 vpent)
      half-height (* 0.5 (item 41 vpent))
      half-width  (* 0.5 (item 40 vpent))
      p1          (Trans
                     (MapCar
                        '+
                        vpcen
                        (List
                           (- half-width)
                           (- half-height)
                           0.0
                        )
                     )
                     vpname
                     ucs
                  )
      p2          (Trans
                     (MapCar
                        '+
                        vpcen
                        (List
                           (- half-width)
                           (+ half-height)
                           0.0
                        )
                     )
                     vpname
                     ucs
                  )
      p3          (Trans
                     (MapCar
                        '+
                        vpcen
                        (List
                           (+ half-width)
                           (+ half-height)
                           0.0
                        )
                     )
                     vpname
                     ucs
                  )
      p4          (Trans
                     (MapCar
                        '+
                        vpcen
                        (List
                           (+ half-width)
                           (- half-height)
                           0.0
                        )
                     )
                     vpname
                     ucs
                  )
   )
   (Command
      "layer" "off" vplayer ""
   )
   (GrDraw p1 p2 color hlite)
   (GrDraw p2 p3 color hlite)
   (GrDraw p3 p4 color hlite)
   (GrDraw p4 p1 color hlite)
)
;-----------------------------------------------------
; PDim MAIN ROUTINE
(bump)
(Defun PDim (/ ok vpnum vpname vpent vport vpnum)
   (If (Not
          (Setq
             ok (Zerop (GetVar "tilemode"))
          )
       )
      (Prompt
         "\n** Command not allowed unless TILEMODE is set to 0 **"
      )
   )
   (Setq undoit T)
   (If ok
      (Progn
         (If (Not
                (Setq
                   in_pspace (= 1 (CAAR (Vports)))
                )
             )
            (Progn
               (Command ".pspace")
               (Prompt
                  "\nSwitching to Paper Space."
               )
            )
         )
         (If (Not
                (Setq
                   ok (TblSearch "layer" vplayer)
                )
             )
            (Prompt
               (Strcat
                  "\n** Viewport layer '"
                  vplayer
                  "' does not exist. **"
               )
            )
         )
      )
   )
   (If ok
      (If (Not
             (Setq
                ok (TblSearch "layer" dimlayer)
             )
          )
         (Prompt
            (Strcat
               "\n** Dimension layer '"
               dimlayer
               "' does not exist. **"
            )
         )
      )
   )
   (If ok
      (Progn
         (Command
            ".layer" "t" vplayer "t" dimlayer "on" vplayer "on"
            dimlayer "set" dimlayer ""
         )
         (Setq
            vport (getvport)
            ok    vport
         )
      )
   )
   (If ok
      (Progn
         (Setq
            vpnum (item
                     69
                     (Setq
                        vpent (EntGet
                                 (Setq vpname (CAR vport))
                              )
                     )
                  )
         )
         (Command ".mspace")
         (Setvar "cvport" vpnum)
         (Command ".ucs" "v")
         (Command ".pspace")
         (Command
            "dim" "dimlfac" "v" vport "exit"
         )
         (Setvar "dimzin" 8) ; suppress trailing zeros
         (Prompt
            (Strcat
               "\nNew value for DIMLFAC: "
               (RtoS (GetVar "dimlfac") 2 4)
            )
         )
         (highlight vpent -1 1)
      )
   )
)
;-----------------------------------------------------
; PDim COMMAND
(bump)
(Defun c:PDim (/ olderror undoit)
   (modes '("cmdecho" "dimzin"))
   (Setq
      olderror *Error*
      *Error*  PDim-error
   )
   (Setvar "cmdecho" 0)
   (Command ".undo" "group")
   (PDim)
   (Command ".undo" "e")
   (moder)
)
(c:PDim)